home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Float source / fInterpret < prev    next >
Text File  |  1992-05-27  |  2KB  |  56 lines
  1. \ fInterpret -- Replaces INTERPRET; provides interpretation of floats
  2. \  5/11/85  ssg Version 1.0  
  3. \  9/19/85  cbd Modified for floating point heap.
  4. \  8/16/86  cdn Replace setupFP with FPinit
  5. \  5/27.92    rfl    moved fpmodel stuff from fval to here; need finterpret running
  6.  
  7. ( addr -- flt t OR f) \ Attempts to convert token at addr to a float.
  8. : fnumber  atof: floati/o ;
  9.  
  10. \ Write a float into dictionary: analogous to , or c, .
  11. \ ( flt -- )
  12. \ : f,   dup 2+ here 10 cmove 10 allot fdrop    ;
  13.  
  14. ( b flt -- )      \ Compiles an in-line float 
  15. : fLiteral  state IF compile flit f, ELSE swap THEN   ; immediate
  16.  
  17.  
  18. ( -- b) \ True means string at here is a float.
  19. : fFind     here fnumber dup          
  20.             IF  swap [compile] fLiteral THEN   ; 
  21.  
  22. ( -- )      \ Adds ability to interpret floats to INTERPRET.
  23. : fInterpret
  24.         BEGIN find
  25.               IF    state  <
  26.                     IF  cfa ,  ELSE cfa execute THEN
  27.                ELSE  fFind not           \ fFind returns true if float found.
  28.                     IF  here number dpl 1+
  29.                         IF      [compile] dliteral
  30.                         ELSE    drop [compile] literal
  31.                         THEN
  32.                     THEN
  33.               THEN  ?stack ?dp
  34.         AGAIN   ;
  35.  
  36. \ store this word in OBJINIT to start up with float enabled
  37. : FPinit   init: floatI/O init: fltMem ;
  38.  
  39. \ new error handler for use with floating point extensions
  40. : cleanFloat  clean2  init: fltMem  ;
  41.  
  42. \ Install finterpret as the new INTERPRET.
  43. : yerk>flt  'c finterpret -> interpret
  44.             'c cleanFloat -> abortVec ;
  45.  
  46. \ Install INTERPRET in nucleus, disabling floating-pt parsing
  47. : yerk>int  0 -> interpret
  48.             'c yerk -> objInit
  49.             'c clean2 -> abortVec ;
  50.  
  51. yerk>flt
  52.  
  53. 0. fvalue fpmodel
  54.  
  55. 'code fpmodel -> fvalcode       \ patch value in Args file
  56.